;;; Zlib bindings, adapted from Guile-zlib
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
;;; Copyright © 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
;;;
;;; This file is part of Guile-zlib.
;;;
;;; Guile-zlib is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Guile-zlib is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guile-zlib.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;;
;;; This file is extracted from Guile-zlib, which was extracted from Guix
;;; and originally writen by Ludovic Courtès.
;;; Bindings to the gzip-related part of zlib's API.  The main limitation of
;;; this API is that it requires a bytevector as the source or sink.
;;;
;;; Code:

(library (gnu gnunet utils decompress)
  (export decompress)
  (import (system foreign)
	  (only (guile) dynamic-link false-if-exception
		dynamic-func)
	  (only (ice-9 match) match)
	  (only (srfi srfi-45) delay force)
	  (only (zlib config) %libz)
	  (rnrs base)
	  (rnrs control)
	  (rnrs exceptions)
	  (rnrs bytevectors)
	  (rnrs conditions))

  (define %zlib
    (delay (dynamic-link %libz)))

  (define (zlib-procedure ret name parameters)
    "Return a procedure corresponding to C function NAME in libz, or #f if
either zlib or the function could not be found."
    (match (false-if-exception (dynamic-func name (force %zlib)))
      ((? pointer? ptr)
       (pointer->procedure ret ptr parameters))
      (#f
       #f)))

  (define-condition-type &z-error &error
    make-z-error z-error?)
  (define-condition-type &z-oom-error &z-error
    make-z-oom-error z-oom-error?)
  (define-condition-type &z-buf-error &z-error
    make-z-buf-error z-buf-error?)
  (define-condition-type &z-data-error &z-error
    make-z-data-error z-data-error?)
  (define-condition-type &z-bogus-error &violation
    make-z-bogus-error z-bogus-error?
    (value z-bogus-error-value))

  (define Z_OK 0)
  (define Z_DATA_ERROR -3)
  (define Z_MEM_ERROR -4)
  (define Z_BUF_ERROR -5)

  (define uncompress!
    (let ((proc (zlib-procedure int "uncompress" `(* * * ,unsigned-long))))
      (lambda (dest-bv dest-offset dest-length
		       source-bv source-offset source-length)
	"Uncompress the source buffer into the destination buffer.

Return the actual buffer size on success, raise an appropriate
&z-error otherwise.

&z-oom-error: out of memory
&z-data-error: corrupted or incomplete data
&z-buf-error: output buffer too small

@var{dest-bv}: destination buffer, as a bytevector
@var{dest-offset}: position of the first byte in @var{dest-bv}
@var{dest-length}: size of @var{dest-bv}. Possibly more than
strictly required."
	;; Verify bounds
	(assert (and (exact? dest-offset)
		     (integer? dest-offset)))
	(assert (and (exact? dest-length)
		     (integer? dest-length)))
	(assert (and (exact? source-offset)
		     (integer? source-offset)))
	(assert (and (exact? source-length)
		     (integer? source-length)))
	(assert (and (<= 0 dest-offset)
		     (<= dest-offset (bytevector-length dest-bv))))
	(assert (and (<= 0 source-offset)
		     (<= source-offset (bytevector-length source-bv))))
	(assert (and (<= (+ source-offset source-length)
			 (bytevector-length source-bv))))
	(assert (and (<= (+ dest-offset dest-length)
			 (bytevector-length dest-bv))))
	(let* ((dest-len-buf
		(make-c-struct `(,unsigned-long) `(,dest-length)))
	       (ret (proc (bytevector->pointer dest-bv dest-offset)
			  dest-len-buf
			  (bytevector->pointer source-bv source-offset)
			  source-length)))
	  (cond ((= ret Z_OK)
		 (list-ref (parse-c-struct dest-len-buf `(,unsigned-long))
			   0))
		((= ret Z_MEM_ERROR) (raise (make-z-oom-error)))
		((= ret Z_BUF_ERROR) (raise (make-z-buf-error)))
		((= ret Z_DATA_ERROR) (raise (make-z-data-error)))
		(else (raise
		       (condition
			(make-z-bogus-error ret)
			(make-message-condition "bogus zlib error value")
			(make-who-condition 'uncompress!)))))))))

  (define decompress
    (case-lambda
      "Uncompress a bytevector with deflate"
      ((input-size output-size input-bv)
       (decompress input-size output-size input-bv 0))
      ((input-size output-size input-bv input-offset)
       "Decompress a source buffer

Return the decompressed buffer as a fresh bytevector.
In case the input is invalid, return #f"
       (guard (ex ((z-buf-error? ex) #f)
		  ((z-data-error? ex) #f))
	 (let* ((bv (make-bytevector output-size))
		(bv-used (uncompress! bv 0 output-size input-bv input-offset
				      input-size)))
	   (and (= bv-used output-size)
		bv)))))))

